(*
 * Copyright (c) Facebook, Inc. and its affiliates.
 *
 * This source code is licensed under the MIT license found in the
 * LICENSE file in the root directory of this source tree.
 *)

(** Singleton types for compare functions *)

(** A comparer [('a, 'compare_a) t] for type ['a] is a "compare" function of type ['a -> 'a -> int]
    tagged with a phantom type ['compare_a] acting as a singleton type denoting an individual
    compare function. *)
type ('a, 'compare_a) t = private 'a -> 'a -> int

module type S = sig
  type ('a, 'compare_a) comparer := ('a, 'compare_a) t

  type t

  (** [compare] types are equipped with functions to support use of
      [@@deriving compare, equal, sexp] on types parameterized by such singleton types for compare
      functions. These derived functions are never actually called, since the compare type
      parameters are phantom. *)
  type compare [@@deriving compare, equal, sexp]

  val comparer : (t, compare) comparer
end

(** [Make] takes a [compare] function, mints a fresh [compare] type to act as a singleton type
    denoting that one compare function, and returns the [compare] function at a type stamped with
    its singleton type. In this way, [Make] applied to two different compare functions for the same
    type of values yields comparers with incompatible types. *)
module Make (Ord : sig
  type t [@@deriving compare]
end) : S with type t = Ord.t

(** [Counterfeit] takes a compare function and type and yields a comparer that asserts that the
    given [compare] type is a singleton for the given [compare] function. This is not checked by the
    type system. It is the client's responsibility to ensure that distinct types are provided for
    distinct compare functions. If the same type is used for multiple functions, then [Counterfeit]
    will produce type-compatible comparers even though the wrapped compare functions differ. *)
module Counterfeit (Ord : sig
  type t [@@deriving compare]

  type compare [@@deriving compare, equal, sexp]
end) : S with type t = Ord.t with type compare = Ord.compare

(** [Apply (F) (A)] takes a type [('a, 'compare_a) F.t] with a type parameter ['a] and a compare
    type ['compare_a] for ['a], and a comparer [A], and creates a comparer for [F.t] with ['a]
    instantiated to [A.t]. *)
module Apply
    (F : sig
      type ('a, 'compare_a) t [@@deriving compare]

      type 'compare_a compare [@@deriving compare, equal, sexp]
    end)
    (A : S) : sig
  type t = (A.t, A.compare) F.t [@@deriving compare]

  include S with type t := t with type compare = A.compare F.compare
end

module type S1 = sig
  type ('a, 'compare_a) comparer := ('a, 'compare_a) t

  type 'a t

  type 'compare_a compare [@@deriving compare, equal, sexp]

  val comparer : ('a, 'compare_a) comparer -> ('a t, 'compare_a compare) comparer
end

(** [Apply1 (F) (A)] takes a type [('a, 'b, 'compare_a) F.t] with two type parameters ['a], ['b] and
    a compare type ['compare_a] for ['a], and a comparer [A], and creates a comparer for [F.t] with
    ['a] instantiated to [A.t]. *)
module Apply1
    (F : sig
      type ('a, 'b, 'compare_a) t [@@deriving compare]

      type ('compare_a, 'compare_b) compare [@@deriving compare, equal, sexp]
    end)
    (A : S) : sig
  type 'b t = (A.t, 'b, A.compare) F.t [@@deriving compare]

  include S1 with type 'b t := 'b t with type 'compare_b compare = (A.compare, 'compare_b) F.compare
end
